home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / error_hn / module / vberrhnd.bas < prev    next >
BASIC Source File  |  1995-02-13  |  8KB  |  271 lines
  1. Option Explicit
  2.  
  3. Global Const VB_LNG_FRENCH = 1
  4. Global Const VB_LNG_DUTCH = 2
  5. Global Const VB_LNG_GERMAN = 3
  6. Global Const VB_LNG_ENGLISH = 4
  7. Global Const VB_LNG_ITALIAN = 5
  8. Global Const VB_LNG_SPANISH = 6
  9.  
  10. Const MB_MESSAGE_LEFT = 0
  11.  
  12. 'Don't change any variables and their value below
  13.  
  14. Const ID_ITEMS = 16
  15.  
  16. Type HNDERRtype
  17.    ModuleName                       As String * 12
  18.    RoutineHandle                    As String * 4
  19.    RoutineName                      As String * 82
  20.    CrLf                             As String * 2
  21. End Type
  22.  
  23. Dim FileLNG                         As String
  24.  
  25. Dim FileHND                         As String
  26.  
  27. Dim FileLOG                         As String
  28.  
  29. Dim IDArray(0 To ID_ITEMS)          As Integer
  30.  
  31. Dim Language                        As Integer
  32. Dim AutoLog                         As Integer
  33. Dim WaitingTimeForReaction          As Integer
  34. Dim DefaultButton                   As Integer
  35.  
  36. Dim HNDERR                          As HNDERRtype
  37.  
  38. Sub mcClearID ()
  39.    Call cClearID(IDArray(0))
  40. End Sub
  41.  
  42. Function mcGetID (nPos As Integer)
  43.    mcGetID = cGetID(IDArray(0), nPos)
  44. End Function
  45.  
  46. Function mcGetLanguageID (LanguageID As Integer) As String
  47.  
  48.    Dim RetLanguage      As String
  49.  
  50.    Select Case LanguageID
  51.       Case VB_LNG_FRENCH
  52.          RetLanguage = "VFR"
  53.       Case VB_LNG_DUTCH
  54.          RetLanguage = "VNL"
  55.       Case VB_LNG_GERMAN
  56.          RetLanguage = "VDE"
  57.       Case VB_LNG_ENGLISH
  58.          RetLanguage = "VUK"
  59.       Case VB_LNG_ITALIAN
  60.          RetLanguage = "VIT"
  61.       Case VB_LNG_SPANISH
  62.          RetLanguage = "VSP"
  63.       Case Else
  64.          RetLanguage = "VUK"
  65.    End Select
  66.    
  67.    If (LanguageID > 0) Then
  68.       Language = LanguageID
  69.    Else
  70.       Language = VB_LNG_ENGLISH
  71.    End If
  72.  
  73.    mcGetLanguageID = RetLanguage
  74.  
  75. End Function
  76.  
  77. Function mcIDErrorHandler (nErr As Integer) As Integer
  78.  
  79.    ' check if this a correct Error passed
  80.    If (nErr = 0) Then
  81.       'if no, resume next
  82.       mcIDErrorHandler = True
  83.       Exit Function
  84.    End If
  85.  
  86.    Dim RoutineCount     As Integer
  87.    Dim RoutineNumber    As Integer
  88.    Dim RoutineStack     As String
  89.    Dim TotalRoutines    As Integer
  90.    Dim BlankLines       As Integer
  91.    Dim Chan             As Integer
  92.    Dim StopExit         As Integer
  93.    Dim TimeOut          As Long
  94.    Dim ButtonsConfig    As Integer
  95.    Dim ErrorTitle       As String
  96.  
  97.    '  some initializations
  98.    RoutineStack = ""
  99.    TotalRoutines = 0
  100.    BlankLines = 0
  101.    StopExit = False
  102.    ButtonsConfig = 0
  103.    ErrorTitle = ""
  104.    RoutineStack = RoutineStack + mcReadText("0", "")
  105.    
  106.    ' find the next valid unused file number.
  107.    Chan = FreeFile
  108.  
  109.    ' open the file with the definition of each routines (file must be in the WINDOWS directory)
  110.    Close #Chan
  111.    Open FileHND For Random Shared As #Chan Len = Len(HNDERR)
  112.  
  113.    ' get the stack of the routines
  114.    For RoutineCount = 0 To ID_ITEMS
  115.       ' get the number of the routine
  116.       RoutineNumber = mcGetID(RoutineCount)
  117.       ' if there a valid routine number
  118.       If (RoutineNumber > 0) Then
  119.          ' yes, read the definition of the routine
  120.          Get #Chan, RoutineNumber, HNDERR
  121.          ' form the stack of the routines founden to display
  122.          RoutineStack = RoutineStack + HNDERR.ModuleName + Chr$(9) + HNDERR.RoutineHandle + Chr$(9) + Trim$(HNDERR.RoutineName) + Chr$(13)
  123.          ' count the routines to display
  124.          TotalRoutines = TotalRoutines + 1
  125.       Else
  126.          ' no, exit from reading the stack
  127.          Exit For
  128.       End If
  129.    Next RoutineCount
  130.  
  131.    ' close the open file
  132.    Close #Chan
  133.  
  134.    ' check if the default button must be activated
  135.    If (DefaultButton = True) Then
  136.       ' yes, RETRY and CANCEL with RETRY is the default
  137.       ButtonsConfig = 5 Or 0
  138.    Else
  139.       ' no, RETRY and CANCEL with CANCEL is the default
  140.       ButtonsConfig = 5 Or 256
  141.       ' yes, add text for RETRY after timeout or action
  142.       RoutineStack = RoutineStack & Chr$(13) & Chr$(13) & "program will be stopped"
  143.    End If
  144.  
  145.    ' set the error title
  146.    ErrorTitle = mcReadText("1", nErr & "~" & Error$(nErr))
  147.  
  148.    ' check if one routine has been founded
  149.    If (Len(RoutineStack) > 0) Then
  150.       ' check the time out
  151.       TimeOut = WaitingTimeForReaction * (163840 Or 524288)
  152.       ' display remaining blank lines
  153.       BlankLines = (8 - TotalRoutines) - (TimeOut = 0)
  154.       For RoutineCount = 0 To BlankLines
  155.          RoutineStack = RoutineStack + Chr$(13)
  156.       Next RoutineCount
  157.       ' add some text for management
  158.       RoutineStack = RoutineStack & mcReadText("2", "")
  159.       ' check if a timeout must be used
  160.       If (TimeOut <> 0) Then
  161.          ' yes, add text depending of the default button
  162.          RoutineStack = RoutineStack & mcReadText("3", "") & " "
  163.          ' if default is RETRY then display 'continue' else 'stop'
  164.          If (DefaultButton = True) Then
  165.             RoutineStack = RoutineStack & mcReadText("4", "")
  166.          Else
  167.             RoutineStack = RoutineStack & mcReadText("5", "")
  168.          End If
  169.       End If
  170.       ' display the error message box
  171.       StopExit = (cLngMsgBox(Language, RoutineStack, MB_MESSAGE_LEFT Or TimeOut Or ButtonsConfig Or 16, ErrorTitle) = 2)
  172.       ' yield process
  173.       DoEvents
  174.    End If
  175.  
  176.    ' check if an auto logging must be performed
  177.    If (AutoLog = True) Then
  178.  
  179.       ' open the logging file in append mode
  180.       Close #Chan
  181.       Open FileLOG For Append Shared As #Chan
  182.  
  183.       ' save the error and his description
  184.       Print #Chan, ErrorTitle; " "; mcReadText("6", Date$ & "~" & Time$)
  185.       Print #Chan, ""
  186.       ' save the full stack name of each routines founden
  187.       Print #Chan, RoutineStack
  188.       Print #Chan, ""
  189.       ' check if the CANCEL button pushed or TimeOut
  190.       If (StopExit = True) Then
  191.          ' yes stop by operator, save text for CANCEL
  192.          Print #Chan, mcReadText("7", "")
  193.       Else
  194.          ' no, retry by operator, save text for RETRY
  195.          Print #Chan, mcReadText("8", "")
  196.       End If
  197.       ' save separator
  198.       Print #Chan, String$(78, "-")
  199.  
  200.       ' close the file
  201.       Close #Chan
  202.  
  203.    End If
  204.  
  205.    ' if stop the program the END the application
  206.    If (StopExit = True) Then End
  207.  
  208.    ' no stop, resumes to next line in the main application
  209.    mcIDErrorHandler = True
  210.  
  211. End Function
  212.  
  213. Sub mcPopID (ID As Integer)
  214.    Call cPopID(IDArray(0), ID)
  215. End Sub
  216.  
  217. Sub mcPopLastID ()
  218.    Call cPopLastID(IDArray(0))
  219. End Sub
  220.  
  221. Sub mcPushID (ID As Integer)
  222.    Call cPushID(IDArray(0), ID)
  223. End Sub
  224.  
  225. Function mcReadText (TextOrder As String, InsertText As String) As String
  226.  
  227.    Dim Tmp              As String
  228.    Dim BasisText        As String
  229.  
  230.    ' read the text in the language file
  231.    BasisText = cGetIni("VBHNDERR", TextOrder, "?", FileLNG)
  232.    
  233.    ' insert some text if any
  234.    Tmp = cInsertBlocks(BasisText, InsertText)
  235.  
  236.    ' change all º by a CR and all ú by TAB
  237.    Call cChangeChars(Tmp, "ºú", Chr$(13) + Chr$(9))
  238.  
  239.    mcReadText = Tmp
  240.  
  241. End Function
  242.  
  243. Sub mcInitID (mcLanguage As Integer, mcAutoLog As Integer, mcWaitingTimeForReaction As Integer, mcDefaultButton As Integer)
  244.  
  245.    'mcLanguage                     'set to TRUE  if you want to use English language
  246.                                    'set to LNG_X if you want to use another language
  247.  
  248.    'mcAutoLog                      'set to TRUE  if you want to make a logging of all errors
  249.                                    'set to FALSE if no logging
  250.  
  251.    'mcWaitingTimeForReaction       'set to TRUE  if no waiting time
  252.                                    'set to 1 for 10 seconds, 2 for 20 seconds, 3 for 30 seconds) to wait before automatic continue
  253.  
  254.    'mcDefaultButton                'set to TRUE  if you want to set the first button als default (RETRY = continue after waiting time has occured)
  255.                                    'set to FALSE if you want to set the second button als default (CANCEL = stop after waiting time has occured)
  256.  
  257.    Call mcClearID
  258.  
  259.    Language = mcLanguage
  260.    AutoLog = mcAutoLog
  261.    WaitingTimeForReaction = mcWaitingTimeForReaction
  262.    DefaultButton = mcDefaultButton
  263.  
  264.    FileLNG = cGetWindowsDirectory() + "\VBHNDERR." + mcGetLanguageID(Language)
  265.  
  266.    FileHND = cGetWindowsDirectory() + "\MODULES.HND"
  267.  
  268.    FileLOG = cGetWindowsDirectory() + "\MODULES.LOG"
  269.  
  270. End Sub
  271.